unit ActiveWindow;

interface

uses
  Windows, SysUtils, Classes, ProcessUtils, TimeUtils, CodeSiteLogging;

Type
  TOnChangeActiveWindow = Procedure(Sender:TObject; FileName, WindowCaption:String) of Object;

  TActiveWindow = Class
    private
      FOnChangeActiveWindow: TOnChangeActiveWindow;
      FRunner: TThread;
      FActive: Boolean;
      FActiveCaption:String;
      FActiveProcessFileName:String;
      procedure SetActive(const Value: Boolean);
    public
      Constructor Create;
      Destructor Destroy; override;
    published
      property Active: Boolean read FActive Write SetActive;
      property OnChangeActiveWindow: TOnChangeActiveWindow read FOnChangeActiveWindow Write FOnChangeActiveWindow;
      property ActiveCapton:String read FActiveCaption Write FACtiveCaption;
      property ActiveProcessFileName:String read FActiveProcessFileName Write FActiveProcessFileName;
  End;

implementation

Type
  TRunner = Class(TThread)
    private
      FSP: Cardinal;
      FOwner: TActiveWindow;
      FLastHwnd, FCurrentHwnd: HWND;
      FLastCaption, FProcessFileName, FCurrentCaption:String;

      procedure GetCurrentActiveWindow;
      procedure CompareActiveWindow;
    protected
      procedure Execute; override;
    public
      constructor Create(AOwner:TActiveWindow); reintroduce; overload;
  End;

{ TActiveWindow }

constructor TActiveWindow.Create;
begin
  FActive := False;
end;

destructor TActiveWindow.Destroy;
begin
  Active := False;
  inherited;
end;

procedure TActiveWindow.SetActive(const Value: Boolean);
begin
  if FActive = value then Exit;

  if Value then  FRunner := TRunner.Create(self)
  else begin
    if Assigned(FRunner) then Frunner.Terminate;
  end;

  FActive := Value;
end;

{ TRunner }

procedure TRunner.CompareActiveWindow;
begin
  if Trim(FCurrentCaption) = '' then Exit;

  if not SameText(FCurrentCaption, FLastCaption) then begin
    FLastCaption := FCurrentCaption;
    FLastHwnd    := FCurrentHwnd;

    FOwner.ActiveCapton := FLastCaption;
    FOwner.ActiveProcessFileName := FProcessFileName;
    if Assigned(FOwner.OnChangeActiveWindow) then
      FOwner.OnChangeActiveWindow(FOwner, FProcessFileName, FLastCaption);
  end;
end;

constructor TRunner.Create(AOwner: TActiveWindow);
begin
  inherited Create(True);
  FOwner := AOwner;
  FreeOnTerminate := True;

  FLastHwnd := 0;
  FCurrentHwnd := 0;
  FLastCaption := '';
  FCurrentCaption := '';
  Resume;
end;

procedure TRunner.Execute;
begin
  FSP := MyGetTickCount;
  while not Terminated do begin
    if MyGetTickDiff(FSP, MyGetTickCount) > 1000 then begin
      FSP := MyGetTickCount;

      GetCurrentActiveWindow;
      CompareActiveWindow;
    end;

    WaitforSingleObject(self.Handle, 10);
  end;
end;

procedure TRunner.GetCurrentActiveWindow;
var
  h: HWND;
  Text: Array[0..254] of char;
  captionLen: integer;
  dwProcessID: DWORD;
  ThreadID: Cardinal;
begin
  h := GetForegroundWindow;
  if h = 0 then Exit;

  if IsWindow(h) then begin
    try
      FillChar(Text, 255, 0);
      FProcessFileName := '';
      ThreadID := GetWindowThreadProcessID(h, @dwProcessID);

      FProcessFileName := GetExecutableFromPID(dwProcessID);
      CaptionLen := GetWindowTextLength(h);
      if CaptionLen >= 255 then Exit;

      GetWindowText(h, text,  255);
      FCurrentCaption := Text;
      FCurrentHwnd := h;
    Except on e:Exception do
      begin
        CodeSite.SendWarning('%s %s', [ self.ClassName,  e.Message ]);
      end;
    end;
  end
  else begin
    CodeSite.SendWarning('%s HWND:[%s] is not window', [ self.ClassName, h ]);
    Exit;
  end;
end;

end.
